Tech Arsenal 1/Tech Arsenal (Arsenal Computer).ISO/tek-02/nktools.zip/MATHUTIL.PAS

Pascal/Delphi Source File | 1990-04-22 | 6KB | 237 lines

UNIT MathUtil;
(*====================================================================*\
|| MODULE NAME:  MathUtil                                             ||
|| DEPENDENCIES: System.TPU                                           ||
|| LAST MOD ON:  9004.22                                              ||
|| PROGRAMMERS:  Andrea Spilholtz, Mike Temkin, SteveAlter,           ||
||               Naoto Kimura                                         ||
||                                                                    ||
|| DESCRIPTION:  This unit contains miscallaneous math routines.      ||
||                                                                    ||
|| Modification history                                               ||
|| 8907.10       Naoto Kimura                                         ||
||               * original version                                   ||
|| 8911.30       Naoto Kimura                                         ||
||               * Added Bound and RBound functions                   ||
|| 9004.22       Naoto Kimura                                         ||
||               * Fixed typo in NumBits                              ||
\*====================================================================*)

{$S+}    {Stack checking on}
{$R+}    {Range checking on}
{$D-}    {Debug info off}
{$I-}    {I/O checking off}

INTERFACE

FUNCTION Max( i1, i2 : integer ) : integer;

FUNCTION Min( i1, i2 : integer ) : integer;

FUNCTION Bound( i, Low, High : Integer ) : Integer;

FUNCTION Sgn( i : real ) : integer;

FUNCTION Sign ( I : Integer ): Integer;

FUNCTION RMax( r1, r2 : real ) : real;

FUNCTION RMin( r1, r2 : real ) : real;

FUNCTION RBound( r, Low, High : Real ) : Real;

FUNCTION RSgn( r : real ) : real;

FUNCTION RSign ( R : Real ): Real;

FUNCTION Ceil ( X : Real ): Real;

FUNCTION Factorial ( N : Integer ) : LongInt;

FUNCTION C ( N, I : Integer ) : LongInt;

FUNCTION ArcTan2 ( DeltaX, DeltaY : Real ): Real;

FUNCTION RadiansToDegrees( Radians : real ) : real;

FUNCTION DegreesToRadians( Degrees : real ) : real;

FUNCTION Dist3D ( X1,Y1,Z1, X2,Y2,Z2: Real ): Real;

FUNCTION NumBits ( L : LongInt ) : Integer;

IMPLEMENTATION

FUNCTION Max( i1, i2 : integer ) : integer;
    BEGIN
    IF i1 > i2 THEN
        Max := i1
    ELSE
        Max := i2
    END;  (* Max *)

FUNCTION Min( i1, i2 : integer ) : integer;
    BEGIN
    IF i1 > i2 THEN
        Min := i2
    ELSE
        Min := i1
    END;  (* Min *)

FUNCTION Bound( i, Low, High : Integer ) : Integer;
    BEGIN
    IF i < Low THEN
        Bound := Low
    ELSE IF i > High THEN
        Bound := High
    ELSE
        Bound := i
    END;  (* Bound *)

FUNCTION Sgn( i : real ) : integer;
    BEGIN
    IF i = 0 THEN
        Sgn := 0
    ELSE IF i > 0 THEN
        Sgn := 1
    ELSE
        Sgn := -1
    END;  (* Sgn *)

FUNCTION Sign ( I : Integer ): Integer;
    BEGIN
    IF I < 0 THEN
        Sign := -1
    ELSE
        Sign := 1;
    END;  (* Sign *)

FUNCTION RMax( r1, r2 : real ) : real;
    BEGIN
    IF r1 > r2 THEN
        RMax := r1
    ELSE
        RMax := r2
    END;  (* RMax *)

FUNCTION RMin( r1, r2 : real ) : real;
    BEGIN
    IF r1 > r2 THEN
        RMin := r2
    ELSE
        RMin := r1
    END;  (* RMin *)

FUNCTION RBound( r, Low, High : Real ) : Real;
    BEGIN
    IF r < Low THEN
        RBound := Low
    ELSE IF r > High THEN
        RBound := High
    ELSE
        RBound := r
    END;  (* RBound *)

FUNCTION RSgn( r : real ) : real;
    BEGIN
    IF r = 0.0 THEN
        RSgn := 0.0
    ELSE IF r > 0.0 THEN
        RSgn := 1.0
    ELSE
        RSgn := -1.0
    END;  (* RSgn *)

FUNCTION RSign ( R : Real ): Real;
    BEGIN
    IF R < 0 THEN
        RSign := -1.0
    ELSE
        RSign := 1.0;
    END;  (* RSign *)

FUNCTION Ceil ( X : Real ): Real;
    BEGIN
    IF Frac(X) <> 0.0 THEN
        Ceil := Int(X)+1.0
    ELSE
        Ceil := Int(X);
    END;  (* Ceil *)

FUNCTION Factorial ( N : Integer ) : LongInt;
    VAR
    F    : LongInt;
    BEGIN
    F := 1;
    WHILE N > 1 DO BEGIN
        F := F * N;
        Dec(N)
      END;
    Factorial := F
    END;    (* C *)

FUNCTION C ( N, I : Integer ) : LongInt;
    VAR
    J,R,D    : LongInt;
    BEGIN
    (* N! / (I! * (N-I)!) *)
    (* N*(n-1)*(n-2)*..*(n-i+1) / i! *)
    r := 1;
    d := 1;
    FOR J := 1 TO I DO BEGIN
        R := R * (N-J+1);
        D := D * J
      END;
    C := R DIV D
    END;    (* C *)

FUNCTION ArcTan2 (DeltaX, DeltaY: Real): Real;
    (* Returns the angle (in radians) represented by DeltaX and DeltaY. *)
    (* Value returned is in range -Pi (exclusive) to +Pi (inclusive).   *)
    VAR
    Angle: Real;
    BEGIN  (* ArcTan2 *)
    IF DeltaX = 0.0 THEN
        ArcTan2 := RSign(DeltaY) * Pi / 2.0
    ELSE BEGIN
        Angle := ArcTan(DeltaY/DeltaX);
        IF DeltaX < 0.0 THEN
        Angle := Angle + RSign(DeltaY) * Pi;
        ArcTan2 := Angle;
      END;
    END;  (* ArcTan2 *)

FUNCTION RadiansToDegrees( Radians : real ) : real;
    BEGIN
    RadiansToDegrees := Radians * 180.0 / Pi
    END;  (* RadiansToDegrees *)

FUNCTION DegreesToRadians( Degrees : real ) : real;
    BEGIN
    DegreesToRadians := Degrees * Pi / 180.0
    END;  (* DegreesToRadians *)

FUNCTION Dist3D (X1,Y1,Z1, X2,Y2,Z2: Real): Real;
    (* Returns distance between 2 points in 3-D space. *)
    BEGIN
    Dist3D := Sqrt(Sqr(X2-X1)+Sqr(Y2-Y1)+Sqr(Z2-Z1));
    END;  (* Dist3D *)

{$L NumBits.OBJ}
FUNCTION NumBits ( L : LongInt ) : Integer;
    External;
{
    VAR
    I    : Integer;
    BEGIN
    I := 0;
    REPEAT
        Inc(I);
        L := (L SHR 1) AND $7fffffff;    (* strip sign *)
    UNTIL L=0;
    NumBits := I
    END;    (* NumBits *)
}

END.